home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte1286.arc / PERRY.ARC / CELL.BAS next >
Encoding:
BASIC Source File  |  1980-01-01  |  4.1 KB  |  119 lines
  1. 10 REM One-dimensional cellular automata
  2. 20 REM by Kenneth E. Perry
  3. 30 REM ---------------------------------------------------
  4. 40 REM Screen setup
  5. 50 KEY OFF
  6. 60 SCREEN 1,0    :REM Medium resolution (320 x 200)
  7. 70 COLOR 0,0    :REM Use color palette 0.
  8. 80 REM ---------------------------------------------------
  9. 90 REM Initialize variables
  10. 100 DEFINT A-Z    :REM All variables are integers.
  11. 110 HRES=320    :REM Number of points in horizontally.
  12. 120 VRES=200    :REM Number of points vertically.
  13. 130 SF=2    :REM SF=1 for denser graph.
  14. 140 BY=10    :REM Offset to leave one line blank.
  15. 150 GN=INT(VRES/SF)-BY
  16. 160 MC=INT(HRES/SF)    :REM Max no. of cells.
  17. 170 IF MC>255 THEN MC=255 :REM Prevent string overflow.
  18. 180 MI=40    :REM Characters/line in graphics mode.
  19. 190 BG=0    :REM Color of background.
  20. 200 NU$=""    :REM No spaces inside quotes
  21. 210 DIM CL(3), A(MC-1), B(MC-1), RU(9), K$(-INT(-MC/MI))
  22. 220 REM Initialize color mapping
  23. 230 FOR J=0 TO 3: READ CL(J): NEXT J
  24. 240 DATA 0,2,3,1
  25. 250 REM --------------------------------------------------
  26. 260 REM Initialize the rule
  27. 270 R$="0000000000"    :REM Ten zeroes
  28. 280 CLS
  29. 290 PRINT "Current rule is shown below. The rule"
  30. 300 PRINT "must contain exactly 10 digits, using"
  31. 310 PRINT "only 0, 1, 2, and 3."
  32. 320 PRINT "Move the cursor across the rule, make"
  33. 330 PRINT "changes as desired, and press <cr>."
  34. 340 PRINT: PRINT R$
  35. 350 LOCATE 7,1
  36. 360 LINE INPUT RT$
  37. 370 IF RT$=NU$ THEN END
  38. 380 IF LEN(RT$)<>10 THEN 280
  39. 390 OK=(1=1)
  40. 400 FOR J=1 TO 10    :REM Make sure the rule is valid.
  41. 410 RU(J-1)=VAL(MID$(RT$,J,1))
  42. 420 OK=(OK AND RU(J-1)>=0 AND RU(J-1)<=3)
  43. 430 NEXT J
  44. 440 IF NOT OK THEN 280 ELSE R$=RT$
  45. 450 REM --------------------------------------------------
  46. 460 REM Get the number of cells in each generation
  47. 470 PRINT USING "How many cells/line (### to ###)";MI,MC;
  48. 480 INPUT NC
  49. 490 IF NC<MI OR NC>MC THEN 470
  50. 500 NL=INT((NC-1)/MI)+1 :REM Lines needed to show 1st gen.
  51. 510 REM --------------------------------------------------
  52. 520 REM Get the initial state of the cellular automaton
  53. 530 PRINT
  54. 540 INPUT "Initial=predefined or random (P/R)";PR$
  55. 550 IF PR$<>NU$ AND INSTR(1,"Rr",PR$)>0 THEN GOSUB
  56.     900 ELSE GOSUB 970
  57. 560 A(0)=0: A(NC-1)=0    :REM Force boundaries to zero.
  58. 570 REM --------------------------------------------------
  59. 580 REM Start the cellular automaton running
  60. 590 CLS
  61. 600 PRINT "Rule ";R$            :REM Display rule
  62. 610 FOR J=0 TO 3
  63. 620 LOCATE 1,20+J*4
  64. 630 PRINT USING "#=";J
  65. 640 NX=168+J*32
  66. 650 LINE (NX,0)-STEP(7,7),CL(J),BF
  67. 660 NEXT J
  68. 670 FOR Y=0 TO GN-1
  69. 680 FOR X=0 TO NC-1
  70. 690 IF X=0 OR X=NC-1 THEN V=3 ELSE V=CL(A(X))
  71. 700 PSET (X*SF,Y*SF+BY),V    :REM Display the point.
  72. 710 NEXT X
  73. 720 REM --------------------------------------------------
  74. 730 REM Compute new state of automaton
  75. 740 FOR X=1 TO NC-2  :REM Don't change boundary cells.
  76. 750 Z=A(X-1)+A(X)+A(X+1)
  77. 760 B(X)=RU(Z)
  78. 770 NEXT X
  79. 780 REM Copy new values to A() from B()
  80. 790 FOR X=1 TO NC-2: A(X)=B(X): NEXT X
  81. 800 IF INKEY$<>NU$ THEN Y=GN-1 :REM Exit if key pressed.
  82. 810 NEXT Y
  83. 820 WHILE INKEY$<>NU$: WEND :REM Clear keyboard buffer.
  84. 830 LOCATE 1,17: PRINT "Continue or quit (C/Q)?";
  85. 840 CQ$=INKEY$
  86. 850 IF CQ$=NU$ THEN 840
  87. 860 WH=INT((INSTR(1,"CcQq",CQ$)+1)/2)+1 :REM wh = 1,2,3.
  88. 870 ON WH GOTO 840, 590, 280
  89. 880 REM --------------------------------------------------
  90. 890 REM Random initialization of automaton.
  91. 900 RANDOMIZE
  92. 910 FOR J=0 TO NC-1
  93. 920 A(J)=INT(RND*4)    :REM Random values from 0 to 3
  94. 930 NEXT J
  95. 940 RETURN
  96. 950 REM --------------------------------------------------
  97. 960 REM Initialize array A() with a preset pattern
  98. 970 FOR J=1 TO NL
  99. 980 IF NC>=J*MI THEN LL=MI ELSE LL=NC-(J-1)*MI
  100. 990 K$(J)=STRING$(LL,".")
  101. 1000 CLS
  102. 1010 PRINT "Rule is: "; R$
  103. 1020 PRINT USING "Cells in range ### to ###:";
  104.      (J-1)*MI+1, (J-1)*MI+LL
  105. 1030 PRINT "Move cursor across the field and make"
  106. 1040 PRINT "changes as desired. Then press <cr>."
  107. 1050 PRINT K$(J)
  108. 1060 LOCATE 5,1
  109. 1070 LINE INPUT K$(J)
  110. 1080 NEXT J
  111. 1090 K$=K$(1)+K$(2)+K$(3)+K$(4)
  112. 1100 REM Convert string to array values.
  113. 1110 FOR J=1 TO NC
  114. 1120 KK$=MID$(K$,J,1)
  115. 1130 IF INSTR(1,"0123",KK$)=0 THEN A(J-1)=BG ELSE
  116.      A(J-1)= VAL(KK$)
  117. 1140 NEXT J
  118. 1150 RETURN
  119.